home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / exeutil.zip / PACK.PAS < prev   
Pascal/Delphi Source File  |  1987-11-17  |  12KB  |  344 lines
  1. {
  2.  PACK reduces the size of EXE files by packing the EXE header table
  3.  into a smaller structure. It does so by using its own fixup relocator,
  4.  and building a table of fixups without redundant segment
  5.  information as occurs in the DOS standard format.
  6.  
  7.  PACK will also report how much space it could save by run-length
  8.  encoding repeated byte sequences. To see this effect, set the
  9.  constant ShowRLEeffect to True. PACK does not actually implement
  10.  this kind of packing at this time.
  11.  
  12.  PACK works in a manner similar to EXEPACK (from Microsoft) and
  13.  SPMAKER (from Realia).
  14.  
  15.  After compiling, just enter PACK to get directions for usage.
  16.  
  17.  Version 1.0.
  18.  Written 11/87, Kim Kokkonen, TurboPower Software.
  19.  Compuserve 72457,2131.
  20.  Released to the public domain.
  21. }
  22. {$S-,I-,R-}
  23.  
  24. program Pack;
  25.   {-Packs EXE file header structure}
  26.  
  27.   function StUpcase(S : string) : string;
  28.     {-Return uppercase of string}
  29.   var
  30.     I : integer;
  31.   begin
  32.     for I := 1 to length(S) do
  33.       S[I] := upcase(S[I]);
  34.     StUpcase := S;
  35.   end;
  36.  
  37.   function HasExtension(Name : string; var DotPos : Word) : Boolean;
  38.     {-Return whether and position of extension separator dot in a pathname}
  39.   var
  40.     I : Word;
  41.   begin
  42.     DotPos := 0;
  43.     for I := Length(Name) downto 1 do
  44.       if (Name[I] = '.') and (DotPos = 0) then
  45.         DotPos := I;
  46.     HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  47.   end;
  48.  
  49.   function ForceExtension(Name, Ext : string) : string;
  50.     {-Return a pathname with the specified extension attached}
  51.   var
  52.     DotPos : Word;
  53.   begin
  54.     if HasExtension(Name, DotPos) then
  55.       ForceExtension := Copy(Name, 1, DotPos)+Ext
  56.     else
  57.       ForceExtension := Name+'.'+Ext;
  58.   end;
  59.  
  60.   procedure Error(Msg : string);
  61.     {-Write error message and halt}
  62.   begin
  63.     if Msg <> '' then
  64.       WriteLn(^M^J, Msg);
  65.     Halt(1);
  66.   end;
  67.  
  68.   function BlkRead(var F : file; var Buffer; Size : Word) : Boolean;
  69.     {-Convenient shell around BlockRead}
  70.   var
  71.     BytesRead : Word;
  72.   begin
  73.     BlockRead(F, Buffer, Size, BytesRead);
  74.     BlkRead := (IoResult = 0) and (BytesRead = Size);
  75.   end;
  76.  
  77.   function BlkWrite(var F : file; var Buffer; Size : Word) : Boolean;
  78.     {-Convenient shell around BlockWrite}
  79.   var
  80.     BytesWritten : Word;
  81.   begin
  82.     BlockWrite(F, Buffer, Size, BytesWritten);
  83.     BlkWrite := (IoResult = 0) and (BytesWritten = Size);
  84.   end;
  85.  
  86.   procedure PackExe(ExeName, OutName : string);
  87.     {-Squeeze an EXE file by packing fixups into segment groups}
  88.   const
  89.     MaxRWbufSize = $8000;    {Max size of read/write buffer for EXE copying}
  90.     FlagWord = $FFFF;        {Flag segment changes in packed relocation table}
  91.     OrigIPofs = 3;           {Position of first patch word in NewLoader}
  92.     ShowRLEeffect = False;   {True to show value of run length encoding}
  93.     Threshold = 4;           {Bytes of overhead per RLE block}
  94.     MaxReloc = $3FFC;        {Maximum allowable relocation items}
  95.  
  96.     NewLoaderSize = 82;
  97.     NewLoader : array[1..NewLoaderSize] of Byte =
  98.     {This is a dump of the COM file generated by assembling NEWLOAD.ASM}
  99.     (
  100.      $EB, $08, $00, $00, $00, $00, $00, $00, $00, $00, $2E, $8C, $1E, $06, $00, $2E,
  101.      $8C, $06, $08, $00, $8C, $C3, $83, $C3, $10, $8C, $C8, $8E, $D8, $BE, $52, $00,
  102.      $FC, $AD, $3D, $FF, $FF, $75, $0B, $AD, $3D, $FF, $FF, $74, $0C, $03, $C3, $8E,
  103.      $C0, $AD, $8B, $F8, $26, $01, $1D, $EB, $E8, $2E, $8E, $06, $08, $00, $2E, $8E,
  104.      $1E, $06, $00, $8B, $C3, $2E, $03, $06, $04, $00, $50, $2E, $A1, $02, $00, $50,
  105.      $CB, $90
  106.      );
  107.  
  108.   type
  109.     ExeHeaderRec =           {Information describing EXE file}
  110.     record
  111.       Signature : Word;      {EXE file signature}
  112.       LengthRem : Word;      {Number of bytes in last page of EXE image}
  113.       LengthPages : Word;    {Number of 512 byte pages in EXE image}
  114.       NumReloc : Word;       {Number of relocation items}
  115.       HeaderSize : Word;     {Number of paragraphs in EXE header}
  116.       MinHeap, MaxHeap : Word; {Paragraphs to keep beyond end of image}
  117.       StackSeg, StackPtr : Word; {Initial SS:SP, StackSeg relative to image base}
  118.       CheckSum : Word;       {EXE file check sum, not used}
  119.       IpInit, CodeSeg : Word; {Initial CS:IP, CodeSeg relative to image base}
  120.       RelocOfs : Word;       {Bytes into EXE for first relocation item}
  121.       OverlayNum : Word;     {Overlay number, not used here}
  122.     end;
  123.     RelocRec =
  124.     record
  125.       Offset : Word;
  126.       Segment : Word;
  127.     end;
  128.     RelocArray = array[1..MaxReloc] of RelocRec;
  129.     PackedTable = array[1..$7FF0] of Word;
  130.     ReadWriteBuffer = array[1..MaxRWbufSize] of Byte;
  131.  
  132.   var
  133.     ExeF, OutF : file;
  134.     BytesRead, BytesWritten, RWbufSize,
  135.     I, TableSize, TablePos, LastSeg,
  136.     BlockSize, OldNumReloc, OldHeaderSize : Word;
  137.     OldExeSize, ExeSize, RLEbytes : LongInt;
  138.     LastByte : Byte;
  139.     ExeHeader : ExeHeaderRec;
  140.     RA : ^RelocArray;        {Old relocation table from input file}
  141.     PT : ^PackedTable;       {New relocation table after packing}
  142.     RWbuf : ^ReadWriteBuffer; {Read/write buffer for file copy}
  143.  
  144.     procedure SetTable(var TA : PackedTable; var TablePos : Word; Value : Word);
  145.       {-Put a value into packed table and increment the index}
  146.     begin
  147.       TA[TablePos] := Value;
  148.       Inc(TablePos);
  149.     end;
  150.  
  151.   begin
  152.  
  153.     {Make sure we don't overwrite the input}
  154.     if StUpcase(ExeName) = StUpcase(OutName) then
  155.       Error('Input and output files must differ');
  156.  
  157.     {Open the existing EXE file}
  158.     Assign(ExeF, ExeName);
  159.     Reset(ExeF, 1);
  160.     if IoResult <> 0 then
  161.       Error(ExeName+' not found');
  162.  
  163.     {Read the existing EXE header}
  164.     if not BlkRead(ExeF, ExeHeader, SizeOf(ExeHeaderRec)) then
  165.       Error('Error reading EXE file');
  166.  
  167.     with ExeHeader do begin
  168.  
  169.       {Assure it's a real EXE file}
  170.       if Signature <> $5A4D then
  171.         Error('File is not in EXE format');
  172.  
  173.       {Check the number of relocation items}
  174.       if NumReloc = 0 then
  175.         Error('No packing can be done. No output written');
  176.       if NumReloc > MaxReloc then
  177.         Error('Number of relocation items exceeds capacity of PACK');
  178.       if NumReloc shl 2 > MaxAvail then
  179.         Error('Insufficient memory');
  180.  
  181.       {Read the relocation items into memory}
  182.       GetMem(RA, NumReloc shl 2);
  183.       Seek(ExeF, RelocOfs);
  184.       if not BlkRead(ExeF, RA^, NumReloc shl 2) then
  185.         Error('Error reading EXE file');
  186.  
  187.       {Determine size of packed relocation table in bytes}
  188.       LastSeg := $FFFF;
  189.       TableSize := 0;
  190.       for I := 1 to NumReloc do
  191.         with RA^[I] do begin
  192.           if Segment <> LastSeg then begin
  193.             LastSeg := Segment;
  194.             {Table will hold FFFF as a flag, followed by new segment}
  195.             Inc(TableSize, 4);
  196.           end;
  197.           {Space for the offset in this record}
  198.           Inc(TableSize, 2);
  199.         end;
  200.       {Termination record}
  201.       Inc(TableSize, 4);
  202.  
  203.       {Build the packed relocation table in memory}
  204.       if TableSize > MaxAvail then
  205.         Error('Insufficient memory');
  206.  
  207.       GetMem(PT, TableSize);
  208.       LastSeg := $FFFF;
  209.       TablePos := 1;
  210.       for I := 1 to NumReloc do
  211.         with RA^[I] do begin
  212.           if Segment <> LastSeg then begin
  213.             LastSeg := Segment;
  214.             {Flag that the segment is changing}
  215.             SetTable(PT^, TablePos, FlagWord);
  216.             {Write the new segment}
  217.             SetTable(PT^, TablePos, Segment);
  218.           end;
  219.           {Write the offset in the segment}
  220.           SetTable(PT^, TablePos, Offset);
  221.         end;
  222.       {Write a termination record}
  223.       for I := 1 to 2 do
  224.         SetTable(PT^, TablePos, FlagWord);
  225.  
  226.       {Deallocate space for the old relocation array}
  227.       FreeMem(RA, NumReloc shl 2);
  228.  
  229.       {Allocate space for the read/write buffer}
  230.       if MaxAvail > MaxRWbufSize then
  231.         RWbufSize := MaxRWbufSize
  232.       else
  233.         RWbufSize := MaxAvail;
  234.       GetMem(RWbuf, RWbufSize);
  235.  
  236.       {Save some items we'll need later}
  237.       OldNumReloc := NumReloc; {items}
  238.       OldHeaderSize :=